home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Appls / ezwalker.f < prev    next >
Encoding:
FORTH Source  |  1988-08-20  |  5.2 KB  |  212 lines
  1. \ Demonstrate the use of JForth's EZMenu system.
  2. \ Use pull down menus in a simple graphics application.
  3. \
  4. \ Author: Phil Burk
  5. \ Delta Research, Box 1051, San Rafael, CA, 94915
  6. \ (415) 485-6867
  7. \ July 8, 1988
  8. \
  9. \ This code is hereby placed in the Public Domain
  10. \ and may be freely distributed.
  11.  
  12. \ (1) Conditionally compile support code not already loaded
  13. include? newwindow.setup ju:amiga_graph
  14. include? ev.getclass     ju:amiga_events
  15. include? ezmenu ju:amiga_menus
  16. include? choose ju:random
  17.  
  18. \ Forget this code if already loaded.
  19. ANEW TASK-EZWALKER.F
  20.  
  21. \ (2) Declare an EZMenu structure.
  22. EZMENU MY-MENU
  23.  
  24. \ (3) -----------------------------------------
  25. \ Variables used to control application.
  26. variable DRAW-MODE   ( lines or boxes )
  27. 0 constant USE_LINES
  28. 1 constant USE_BOXES
  29.  
  30. variable QUIT-NOW    ( time to stop? )
  31. variable LAST-X
  32. variable LAST-Y
  33.  
  34. \ Define words (functions) to call when menu item picked.
  35. : USE.LINES  ( -- , set application drawing mode to lines)
  36.     use_lines draw-mode !
  37.     last-x @ last-y @ gr.move
  38. ;
  39.  
  40. : USE.BOXES  ( -- , now draw boxes )
  41.     use_boxes draw-mode !
  42. ;
  43.  
  44. \ (4) Call any Amiga Library routine by name
  45. \ using the JForth CALL facility.
  46. : CLEAR.WINDOW ( -- , set rastport to color 0 )
  47.     gr-currport @ ( get absolute addr of window rastport)
  48.     0     ( background color )
  49.     call graphics_lib SetRast   ( call Amiga routine )
  50.     drop  ( don't need return value )
  51. ;
  52.  
  53. : QUIT.DRAWING  ( -- , set termination flag )
  54.     quit-now on
  55. ;
  56.  
  57. \ (5) --------------------------------------------
  58. \ Set up Menu and Menu items using EZMENU system.
  59. : MY-MENU.INIT  ( -- , initialize menu )
  60.     110 menuitem-defwidth !  ( set default item width )
  61. \ Allocate space for 4 menu items with intuitext structures
  62.     4 my-menu ezmenu.alloc
  63. \
  64. \ Set name of menu and position in list.
  65.     0" Choose" 0 my-menu ezmenu.setup
  66. \
  67. \ Define the text for each menu item.
  68.     0" Lines" 0 my-menu ezmenu.text!
  69.     0" Boxes" 1 my-menu ezmenu.text!
  70.     0" Clear" 2 my-menu ezmenu.text!
  71.     0" Quit"  3 my-menu ezmenu.text!
  72. \
  73. \ Set the function to call for each menu item.
  74. \ Pull off stack in reverse order.
  75.     ' quit.drawing    ' clear.window
  76.     ' use.boxes       ' use.lines
  77.     4 0 DO  i my-menu ezmenu.cfa[] !  LOOP
  78. \
  79. \ (6) Set lines and boxes item to have exclusive checkmarks
  80.     [ BINARY ] ( Use base 2 to express exclusion pattern.)
  81.     0010 0 my-menu ezmenu.exclude!
  82.     0001 1 my-menu ezmenu.exclude!
  83.     CHECKED 0 my-menu ezmenu.set.flag
  84.     [ DECIMAL ]
  85. \
  86. \ (7) Set Command Sequence keys for Clear and Quit.
  87.     ascii C 2 my-menu ezmenu.commseq!
  88.     ascii Q 3 my-menu ezmenu.commseq!
  89. ;
  90.  
  91. \ (8) ----------------------------------------------
  92. \ Code for drawing lines and boxes.
  93. : SAFE.RECT ( x1 y1 x2 y2 - , sort corners and draw )
  94.     >r swap >r 2sort  ( sort X values )
  95.     r> r> -2sort      ( sort Y values )
  96.     -rot     ( -- x y x y )
  97.     gr.rect
  98. ;
  99.  
  100. : DRAW.NEW.XY ( x y -- , draw either a line or a box )
  101.     draw-mode @
  102.     use_lines =
  103.     IF  2dup gr.draw
  104.     ELSE
  105.         2dup last-x @ last-y @ safe.rect
  106.     THEN
  107.     last-y ! last-x !
  108. ;
  109.  
  110. : NEXT.COLOR ( -- , Cycle through colors 1,2,3 )
  111.     gr.color@ 1+ dup 3 >
  112.     IF drop 1
  113.     THEN  gr.color!
  114. ;
  115.  
  116. \ Select random distances for random walk.
  117. : CALC.DELTA.X ( -- dx )
  118.     41 choose 20 -
  119. ;
  120. : CALC.DELTA.Y ( -- dy )
  121.     21 choose 10 -
  122. ;
  123.  
  124. : WANDER.XY ( -- , random walk )
  125. \ Add a number between -20 and +20
  126.     last-x @ calc.delta.x +
  127. \ Clip to 0 and current window size.
  128. \ Note reference to window structure.
  129.     0 max gr-curwindow @ ..@ wd_gzzwidth min
  130. \
  131.     last-y @ calc.delta.y +
  132.     0 max gr-curwindow @ ..@ wd_gzzheight min
  133.     draw.new.xy
  134. ;
  135.  
  136. \ (9) --------------------------------------
  137. \ Process IDCMP events. 
  138. : HANDLE.EVENT ( event_class -- )
  139.     CASE
  140. \ Call functions set using EXMENU.CFA[] !
  141.         MENUPICK
  142.         OF  ev-last-code @ my-menu ezmenu.exec
  143.         ENDOF
  144. \
  145. \ Set quit flag if CLOSEBOX hit.
  146.         CLOSEWINDOW
  147.         OF quit-now on
  148.         ENDOF
  149. \
  150.         ." Unrecognized event!" cr
  151.     ENDCASE
  152. ;
  153.  
  154. \ Draw lines or boxes until told to quit.
  155. : LOOP.DRAW ( -- )
  156.     quit-now off
  157.     BEGIN
  158.         wander.xy  ( do graphics )
  159.         next.color
  160. \
  161.         gr-curwindow @ ev.getclass ?dup
  162.         IF handle.event
  163.         THEN
  164.         quit-now @
  165.     UNTIL
  166. ;
  167.  
  168. \ Declare new window structure.
  169. NewWindow MY-WINDOW
  170.  
  171. : EZWALKER.INIT ( -- , set everything up )
  172.     gr.init  ( initialize graphics system )
  173.     my-window newwindow.setup  ( set defaults )
  174. \
  175. \ Change window title using structure access word ..!
  176.     0" EZWAlker  in JForth  by Phil Burk" >abs
  177.     my-window ..! nw_Title
  178. \
  179. \ Set flags for window to allow menus.
  180.     CLOSEWINDOW MENUPICK |
  181.     my-window ..! nw_IDCMPFlags
  182. \ Make window automatically active.
  183.     MY-WINDOW ..@ nw_Flags   ACTIVATE |
  184.     MY-WINDOW ..! nw_Flags
  185. \
  186. \ Open window based on NewWindow template
  187.     my-window gr.openwindow gr.set.curwindow
  188. \
  189. \ Initialize menu and attach to window.
  190.     my-menu.init
  191.     gr-curwindow @ my-menu SetMenuStrip()
  192. \
  193. \ Start in middle of window
  194.     gr_xmax 2/ last-x !
  195.     gr_ymax 2/ last-y !
  196.     use.lines
  197. ;
  198.  
  199. : EZWALKER.TERM ( -- , clean up menus and close window. )
  200.     gr-curwindow @ ClearMenuStrip()
  201.     gr.closecurw
  202.     my-menu ezmenu.free
  203. ;
  204.  
  205. : EZWALKER ( -- , do it all)
  206.     EZWALKER.init
  207.     loop.draw
  208.     EZWALKER.term
  209. ;
  210.     
  211. cr ." Enter:    EZWALKER    to see demo." cr
  212.